home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 25 / Mac Magazin and MacEasy Magazine CD - Issue 25.iso / Grafik & Text / Alpha / Tcl / Menus / filesetsMenu.tcl < prev    next >
Text File  |  1996-08-15  |  40KB  |  1,445 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "filesets.tcl"
  6.  #                                      created: 24/3/96 {12:58:05 pm} 
  7.  #                                  last update: 13/6/96 {1:58:16 am} 
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <vince@das.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #==============================================================================
  15.  # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  16.  # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  17.  # on occasion, but this isn't critical.
  18.  #==============================================================================
  19.  # 
  20.  #  modified by  rev reason
  21.  #  -------- --- --- -----------
  22.  #  24/3/96  VMD 1.0 update of Pete's original to allow mode-specific filesets
  23.  #  27/3/96  VMD 1.1 added hierarchial filesets, and checks for unique menus
  24.  #  13/6/96  VMD 1.2 memory efficiency improvements with 'fileSets' array
  25.  # ###################################################################
  26.  ##
  27.  
  28. ## 
  29.  # These procedures    are    now    more robust    and    general-purpose. Basic new
  30.  # features    are: 
  31.  # 
  32.  #       *  user configurable    menu
  33.  #       *  unique-menu names    are    ensured, so    there can be no    clashes
  34.  #       *  new fileset types    ('tex' and 'fromHierarchy')
  35.  #       *  new utility functions    ('stuff', 'wordCount',...)
  36.  #       *  filesets need    not    appear in the menu;    in fact    they can be
  37.  #          anywhere you like
  38.  ##
  39.  
  40. if $startingUp {
  41.     addMenu fsetMenuName
  42.     set fsetMenuName     "•131"
  43.     return
  44. }
  45.  
  46. ## 
  47.  # -------------------------------------------------------------------------
  48.  #     
  49.  # "gCheckset" --
  50.  #    
  51.  #    If the global variable 'var' isn't yet defined,    it is set to the
  52.  #    value 'val'.  Else nothing happens.
  53.  #           
  54.  # -------------------------------------------------------------------------
  55.  ##
  56. proc gCheckset {var val} {
  57.     if [uplevel \#0 info exists $var] { return [uplevel \#0 set $var] }
  58.     uplevel \#0 set $var \{$val\}
  59.     return $val
  60. }
  61.  
  62. proc fsetMenuName {} {}
  63. # Build some filesets on the fly.
  64. catch {unset fileSets}
  65. catch {unset currFileSet}
  66. set gfileSets(Help) "$HOME:Help:*"
  67. set gfileSets(System) "$HOME:Tcl:SystemCode:*.tcl"
  68. set gfileSets(Menus) "$HOME:Tcl:Menus:*.tcl"
  69. set gfileSets(Modes) "$HOME:Tcl:Modes:*.tcl"
  70. set gfileSetsType(Help) "fromDirectory"
  71. set gfileSetsType(System) "fromDirectory"
  72. set gfileSetsType(Menus) "fromDirectory"
  73. set gfileSetsType(Modes) "fromDirectory"
  74.  
  75. if !$alphaLite { 
  76.     set gfileSets(User) "$HOME:Tcl:UserCode:*.tcl"
  77.     set gfileSetsType(User) "fromDirectory"
  78. }
  79.  
  80. # Default curr fileset is the first one. Can be changed in 'prefs.tcl'.
  81. set currFileSet [lindex [array names gfileSets] 0]
  82.  
  83. #################################################
  84. #                                                #
  85. #    Section    1:    Fileset    variables and flags.    #
  86. #                                                #
  87. #################################################
  88. # Any of these can be over-ridden by the stored #
  89. # definitions in defs.tcl, arrdefs.tcl          #
  90. #################################################
  91.  
  92. ## 
  93.  # We don't    show the 'help'    fileset, since it's    under the MacOS
  94.  # AppleGuide menu.     Also we could perhaps yank    tex-filesets away
  95.  # into    their own menu,    in which case the tex-system could add to
  96.  # this    variable as    it went    along.
  97.  ##
  98. gCheckset filesetsNotInMenu "Help" 
  99.  
  100. ## 
  101.  # A type is a means of    generating a fileset given its 
  102.  # description in the variable 'gfileSets(name)':
  103.  ##
  104. gCheckset fileSetsTypes { "list" "glob" "fromHierarchy" }
  105.  
  106. ## 
  107.  # A menu type is a    means of prompting the user    and    
  108.  # characterising the interface    to a type, even
  109.  # though the actual storage may be    very simple
  110.  # (a list in most cases).
  111.  ##
  112. set fileSetsTypesMenu(fromDirectory) "glob"
  113. set fileSetsTypesMenu(fromHierarchy) "fromHierarchy"
  114. set fileSetsTypesMenu(think) "list"
  115. set fileSetsTypesMenu(codewarrior) "list"
  116. set fileSetsTypesMenu(ftp) "list"
  117. set fileSetsTypesMenu(fromOpenWindows) "list"
  118.  
  119. ## 
  120.  # To add a    new    fileset    type, you need to define the following:
  121.  #       set fileSetsTypesMenu(myType) "list"
  122.  #       proc    myTypeCreateFileset    {} {}
  123.  #       proc    myTypeFilesetUpdate    {name} {}
  124.  # 
  125.  # For more    complex    types (e.g.    the    tex-type), define as follows:
  126.  #       set fileSetsTypesMenu(myType) "myType"
  127.  #       proc    myTypeCreateFileset    {} {}
  128.  #       proc    myTypeFilesetSelected {    fset menu item }    {}
  129.  #       proc    myTypeFilesetUpdate    { name } {}
  130.  #       proc    myTypeListFilesInFileset { name    } {}
  131.  #       proc    myTypeMakeFileSetSubMenu { name    } {}
  132.  # 
  133.  # These procedures    will all be    called automatically under the
  134.  # correct circumstances.  The purposes of these are as follows:
  135.  #
  136.  #   'create'   -- query the user for name etc. and create
  137.  #   'update'   -- given the information in 'gfileSets', recalculate
  138.  #                   the member files.
  139.  #   'selected' -- a member was selected in a menu.
  140.  #   'list'     -- given info in all except 'fileSets', return list
  141.  #                 of files to be stored in that variable.
  142.  #   'submenu'  -- generate the sub-menu
  143.  # 
  144.  # Your    code may wish to call 'isWindowInFileset ?win? ?type?' to
  145.  # check if    a given    (current by    default) window    is in a    fileset    of
  146.  # a given type.
  147.  ##
  148.  
  149. ## 
  150.  # -------------------------------------------------------------------------
  151.  #     
  152.  #    "filesetSortOrder" --
  153.  #    
  154.  #       The structure of    this variable dictates how the fileset
  155.  #       menu    is structured:
  156.  #           
  157.  #           '{pattern p}' 
  158.  #               lists all filesets which    match 'p'
  159.  #           '-' 
  160.  #               adds    a separator    line
  161.  #           '{list of types}' 
  162.  #               lists all filesets of those types.
  163.  #           '{submenu name sub-order-list}' 
  164.  #               adds    a submenu with name    'name' and recursively
  165.  #               adds    filesets to    that submenu as    given by the 
  166.  #               sub-order.
  167.  #               
  168.  #       Leading,    trailing and double    separators are automatically
  169.  #       removed.
  170.  #     
  171.  # -------------------------------------------------------------------------
  172.  ##
  173. gCheckset filesetSortOrder { {pattern System} {pattern Menus} {pattern Modes} {pattern User} {pattern Preferences} \
  174.                         - {tex} - {pattern *.cc} {submenu Headers {pattern *.h}} \
  175.                         - {fromDirectory think codewarrior ftp \
  176.                         fromOpenWindows fromHierarchy} * } 
  177.                         
  178. set    "filesetUtils(browseFileset…)" [list * browseFileset]
  179. set    "filesetUtils(renameFileset…)" [list * renameFileset]
  180. set    "filesetUtils(openEntireFileset…)" [list * openEntireFileset]
  181. set    "filesetUtils(filesetToAlpha…)" [list * filesetToAlpha]
  182. set    "filesetUtils(closeEntireFileset…)" [list * closeEntireFileset]
  183. set    "filesetUtils(replaceInFileset…)" [list * replaceInFileset]
  184. set    "filesetUtils(stuffFileset…)" [list * stuffFileset]
  185. set    "filesetUtils(wordCount)" [list * wordCountFileset]
  186. set    "filesetUtils(wordCountFast)" [list * wordCountFilesetFast]
  187. set    "filesetUtils(openFilesetFolder…)" [list * openFilesetFolder]
  188.  
  189.  
  190. ## 
  191.  # The meaning of these    flags is as    follows:
  192.  #       sortFilesetItems    -- 
  193.  #           a type can have the option of being unsorted    (e.g. tex-filesets)
  194.  #       indentFilesetItems --
  195.  #           visual formatting may be    of relevance to    some types
  196.  #       sortFilesetsByType -- 
  197.  #           use the variable    'filesetSortOrder' to determine    the
  198.  #           visual structure    of the fileset menu
  199.  #       autoAdjustFileset --
  200.  #           when    a file is selected from    the    menu, do we    try    and    
  201.  #           keep    'currFileSet' accurate?
  202.  #       includeNonTextFiles --
  203.  #           filesets may include non-text files.  Alpha will tell the
  204.  #           finder to open these if they are selected.
  205.  ##        
  206. foreach    flag { sortFilesetItems    indentFilesetItems sortFilesetsByType \
  207.                autoAdjustFileset includeNonTextFiles } {
  208.     gCheckset filesetFlags($flag) 0
  209. }
  210. unset flag
  211. set filesetFlagsRebuild(sortFilesetsByType) "*"
  212. set filesetFlagsRebuild(includeNonTextFiles) "*"
  213.  
  214. # To add a new fileset type, all we have to do is this:
  215. set fileSetsTypesMenu(tex) "tex"
  216. lappend fileSetsTypes "tex"
  217. # If you create new types just add lines like that to
  218. # your "prefs.tcl", or install them permanently using
  219. # addDef and addArrDef.
  220.  
  221. #===========================================================================
  222. # The support routines.
  223. #===========================================================================
  224. # Called from Alpha to get list of files for current file set.
  225. proc getCurrFileSet {} {
  226.     global currFileSet
  227.     return [getFileSet $currFileSet]
  228. }
  229.  
  230. # Called from Alpha to get names. The first name returned is taken to 
  231. # be the current fileset.
  232. proc getFileSetNames {} {
  233.     global gfileSets currFileSet
  234.     set ind [lsearch [array names gfileSets] $currFileSet]
  235.     if {$ind < 0} {set ind 0}
  236.     return [linsert [lsort [lreplace [array names gfileSets] $ind $ind]] 0 $currFileSet]
  237. }
  238.  
  239.  
  240. # Keep 'sets' menu up to date.
  241. trace vdelete currFileSet w shadowCurrFileSet
  242. trace variable currFileSet w shadowCurrFileSet
  243. proc shadowCurrFileSet {nm1 nm2 op} {
  244.     global gfileSets currFileSet
  245.     foreach name [array names gfileSets] {
  246.         if {$name == $currFileSet} {
  247.             catch {markMenuItem -m choose $name on}
  248.         } else {
  249.             catch {markMenuItem -m choose $name off}
  250.         }
  251.     }
  252.     return $currFileSet
  253. }
  254.  
  255.  
  256. #================================================================================
  257. # Edit a file from a fileset via list dialogs (no mousing around).
  258. #================================================================================
  259. proc editFile {} {
  260.     global currFileSet modifiedVars gfileSetsType
  261.     
  262.     set fset [pickFileset "" {Fileset?} "list" [list {*recent*}]]
  263.     set currFileSet $fset
  264.     lappend modifiedVars currFileSet
  265.     
  266.     if {$fset == {*recent*}} {return [editRecentFile]}
  267.     set ff [getFilesInSet $fset]
  268.     foreach f $ff {
  269.         lappend disp [file tail $f]
  270.     }
  271.     foreach res [listpick -l -p {File?} [lsort -ignore $disp]]  {
  272.         set ind [lsearch $ff \*:$res]
  273.         if {$gfileSetsType($fset) == "ftp"} {
  274.             ftpFilesetOpen $fset [lindex $ff $ind]
  275.         } else {
  276.             catch {generalOpenFile [lindex $ff $ind]}
  277.         }
  278.     }
  279. }
  280.  
  281. # We only return TEXT files, since we don't want Alpha
  282. # manipulating the data fork of non-text files.
  283. proc getFileSet {fset} {
  284.     global filesetFlags
  285.     if $filesetFlags(includeNonTextFiles) {
  286.         set fnames ""
  287.         foreach f [getFilesInSet $fset] {
  288.             getFileInfo $f a
  289.             if {$a(type) == "TEXT"} {
  290.                 lappend fnames $f
  291.             }
  292.         }
  293.         return $fnames
  294.     } else {
  295.         return [getFilesInSet $fset]
  296.     }
  297. }
  298.  
  299. proc browseFileset {{fset ""}} {
  300.     global tileLeft tileTop tileWidth errorHeight
  301.  
  302.     set fset [pickFileset $fset {Fileset?}]
  303.  
  304.     foreach f [getFilesInSet $fset] {
  305.         append text "\t[file tail $f]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  306.     }
  307.     new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight
  308.     global winModes
  309.     set name [lindex [winNames] 0]
  310.     changeMode [set winModes($name) Brws]
  311.  
  312.     insertText "(<cr> to go to file)\r-----\r$text\r"
  313.     goto 0
  314.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  315.     setWinInfo dirty 0
  316.     setWinInfo read-only 1
  317.     message ""
  318. }    
  319.  
  320. ############################################
  321. #                                           #
  322. #    Section    2:    Basic fileset procedures   #
  323. #                                           #
  324. ############################################
  325.  
  326. proc newFileset {} {
  327.     global currFileSet gfileSetsType fileSetsTypesMenu
  328.     set type [eval [list prompt "New fileset type?" \
  329.                 "fromDirectory" "Type:"] [lsort -ignore [array names fileSetsTypesMenu]]]
  330.     set name [eval ${type}CreateFileset]
  331.  
  332.     if ![string length $name] return
  333.     
  334.     addArrDef gfileSetsType $name $type
  335.     set gfileSetsType($name) $type
  336.  
  337.     set currFileSet $name
  338.     rebuildAllFilesets
  339.     return $currFileSet
  340. }
  341.  
  342. proc deleteFileset { {fset ""} {yes 0} } {
  343.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  344.     global fsetMenuName subMenuFilesetInfo subMenuInfo
  345.     
  346.     set fset [pickFileset $fset "Delete which Fileset?"]
  347.      if {$currFileSet == $fset} {catch {set currFileSet System}}
  348.  
  349.     if {$yes || [askyesno "Delete fileset \"$fset\"?"] == "yes"} {
  350.         catch {unset "fileSetsExtra($fset)"}
  351.         catch {unset "gfileSetsType($fset)"}
  352.         catch {unset "fileSets($fset)"}
  353.         catch {unset "gfileSets($fset)"}
  354.         
  355.         removeArrDef gfileSetsType $fset
  356.         catch {removeArrDef fileSetsExtra $fset}
  357.         removeArrDef gfileSets $fset
  358.  
  359.         # find its menu:
  360.         set base ""
  361.         foreach m $subMenuFilesetInfo($fset) {
  362.             # remove info about it's name
  363.             catch {unset subMenuInfo($m)}
  364.             catch {removeMenu $m}
  365.             # try and remove it's base from the main menu too
  366.             if { [string trimright $m] == $fset } { set base $m }
  367.         }
  368.         unset subMenuFilesetInfo($fset)
  369.         
  370.         if [catch {deleteMenuItem -m $fsetMenuName $base}] {
  371.             # it's on a submenu or somewhere else so we just have
  372.             # to do the lot!
  373.             if !$yes { rebuildAllFilesets }
  374.         } else {
  375.             deleteMenuItem -m choose $fset
  376.             deleteMenuItem -m hideFileset $fset
  377.         }
  378.     }
  379. }
  380.  
  381. ## 
  382.  # -------------------------------------------------------------------------
  383.  #     
  384.  #    "pickFileset" --
  385.  #    
  386.  #     Ask the user for a/several    filesets.  If 'fset' is    set, we    just
  387.  #     return    that (this avoids 'if {$fset !=    ""}    { set fset [pick...] }
  388.  #     constructs    everywhere).  A    prompt can be given, and a dialog type
  389.  #     (either a listpick, a pop-up menu,    or a listpick with multiple
  390.  #     selection), and extra items can be    added to the list if desired.
  391.  # -------------------------------------------------------------------------
  392.  ##
  393. proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
  394.     global gfileSets currFileSet
  395.     if { $fset != "" } { return $fset }
  396.     switch $type {
  397.         "popup" {
  398.             set fset [eval [list prompt $prompt \
  399.                 $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
  400.             if ![info exists gfileSets($fset)] { error "No such fileset" }
  401.             return $fset
  402.         }
  403.         "list" {
  404.             return [listpick -p $prompt -L $currFileSet \
  405.                 [lsort -ignore [concat $extras [array names gfileSets]]]]
  406.         }
  407.         "multilist" {
  408.             return [listpick -p $prompt -l -L $currFileSet \
  409.                 [lsort -ignore [concat $extras [array names gfileSets]]]]
  410.         }        
  411.     }
  412. }
  413.  
  414. proc renameFileset {} {
  415.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  416.     global fileSetsTypesMenu
  417.     
  418.     set fset [pickFileset "" {Fileset to rename?}]
  419.      
  420.     set name [getline "Rename to:" $fset]
  421.     if {![string length $name] || $name == $fset} return
  422.  
  423.     set gfileSets($name) $gfileSets($fset)
  424.     set gfileSetsType($name) $gfileSetsType($fset)
  425.     catch {set fileSets($name) $fileSets($fset)}
  426.     catch {set fileSetsExtra($name) $fileSetsExtra($fset)}
  427.  
  428.     deleteFileset $fset 1
  429.     
  430.     addArrDef gfileSets $name $gfileSets($name)
  431.     addArrDef gfileSetsType $name $gfileSetsType($name)
  432.     catch {addArrDef fileSetsExtra $name $fileSetsExtra($name)}
  433.     
  434.     rebuildAllFilesets
  435.     set currFileSet $name
  436. }
  437.  
  438. proc updateCurrentFileset {} {
  439.     global currFileSet gfileSetsType
  440.     set type $gfileSetsType($currFileSet)
  441.     catch {eval "${type}FilesetUpdate" \{$currFileSet\} }
  442.     eval [makeFileSetAndMenu $currFileSet 1]
  443.     
  444.     callFilesetUpdateProcedures $currFileSet
  445. }
  446.  
  447. proc callFilesetUpdateProcedures { {fset ""} } {
  448.     global filesetUpdateProcs gfileSetsType
  449.     if { $fset == "" } {
  450.         set types [array names filesetUpdateProcs]
  451.     } else {
  452.         set types $gfileSetsType($fset)
  453.     }
  454.     
  455.     foreach l $types {
  456.         if [info exists filesetUpdateProcs($l)] {
  457.             foreach proc $filesetUpdateProcs($l) {
  458.                 eval $proc
  459.             }
  460.         }
  461.     }
  462.     
  463. }
  464.  
  465. proc listContains { list item } { return [expr [lsearch -exact $list $item] != -1] }
  466.  
  467.  
  468. ##################################################
  469. #                                                 #
  470. #    Section    3: Creation    of basic fileset types     #
  471. #                                                 #
  472. ##################################################
  473.  
  474. proc fromDirectoryCreateFileset {} {
  475.     global gfileSets gfileSetsType    
  476.     
  477.     set name [getFilesetDirectoryAndPattern]
  478.     if ![string length $name] return
  479.     
  480.     set gfileSetsType($name) "fromDirectory"
  481.     
  482.     if {[askyesno "Save new fileset?"] == "yes"} {
  483.         addArrDef gfileSets $name $gfileSets($name)
  484.         addArrDef gfileSetsType $name "fromDirectory"
  485.     }
  486.     return $name
  487. }
  488.  
  489. proc getFilesetDirectoryAndPattern {} {
  490.     global gfileSets
  491.     set name [getline "New fileset name:" ""]
  492.     if {![string length $name]} return
  493.     
  494.     set dir [string trim [get_directory -p "New fileset dir:"] ":"]
  495.     if {![string length $dir]} return
  496.     
  497.     set filePat [getline "File pattern:" "*"]
  498.     if {![string length $filePat]} return
  499.     
  500.     set gfileSets($name) "$dir:$filePat"
  501.     return $name
  502. }
  503.  
  504. proc fromDirectoryFilesetUpdate {name} {
  505.     # done on the fly so no need to update
  506.     #global fileSets gfileSets
  507.     #set fileSets($name) [glob -nocomplain -t TEXT "$gfileSets($name)"]
  508. }
  509.  
  510. proc fromHierarchyCreateFileset {} {
  511.     global gfileSets gfileSetsType    
  512.     
  513.     set name [getFilesetDirectoryAndPattern]
  514.     if ![string length $name] return
  515.     
  516.     set gfileSetsType($name) "fromHierarchy"
  517.     set depth [listpick -p "Depth of hierarchy?" -L 3 {1 2 3 4 5 6 7}]
  518.     if { $depth == "" } {set depth 3}
  519.     
  520.     set gfileSets($name) [list $gfileSets($name) $depth]
  521.     
  522.     if {[askyesno "Save new fileset?"] == "yes"} {
  523.         addArrDef gfileSets $name $gfileSets($name)
  524.         addArrDef gfileSetsType $name "fromHierarchy"
  525.     }
  526.     return $name
  527. }
  528.  
  529. proc fromHierarchyFilesetUpdate {name} {
  530.     global fileSets gfileSets
  531.     set fileSets($name) [fromHierarchyListFilesInFileSet $name]
  532. }
  533.  
  534. proc fromHierarchyMakeFileSetAndMenu {name andMenu} {
  535.     global filesetTemp fileSets gfileSets
  536.     set dir [file dirname [lindex $gfileSets($name) 0]]
  537.     set patt [file tail [lindex $gfileSets($name) 0]]
  538.     set depth [lindex $gfileSets($name) 1]
  539.     # we make the menu as a string, but can bin it if we like
  540.     set menu [buildSubMenu [list $dir] $name filesetProc filesetTemp $patt $depth $name]
  541.     
  542.     # we need to construct the list of items
  543.     set fileSets($name) {}
  544.     foreach n [array names filesetTemp] {
  545.         lappend fileSets($name) $filesetTemp($n)
  546.     }
  547.     unset filesetTemp
  548.     return $menu
  549. }
  550.  
  551. proc fromHierarchyFilesetSelected {fset menu item} {
  552.     global gfileSets
  553.     set dir [file dirname [lindex $gfileSets($fset) 0]]
  554.     set ff [getFilesInSet $fset]
  555.     if { $fset == $menu } {
  556.         # it's top level
  557.         if {[set match [lsearch $ff ${dir}:$item]] >= 0} {
  558.             autoUpdateFileset $fset
  559.             generalOpenFile [lindex $ff $match]
  560.             return
  561.         }
  562.     }
  563.     # the following two are slightly cumbersome, but give us the best
  564.     # chance of finding the correct file given any ambiguity (which can
  565.     # certainly arise if file and directory names clash excessively).
  566.     if {[set match [lsearch $ff ${dir}:${menu}:$item]] >= 0} {
  567.         autoUpdateFileset $fset
  568.         generalOpenFile [lindex $ff $match]
  569.         return
  570.     }
  571.     if {[set match [lsearch $ff ${dir}:*:${menu}:$item]] >= 0} {
  572.         autoUpdateFileset $fset
  573.         generalOpenFile [lindex $ff $match]
  574.         return
  575.     }
  576.     alertnote "Weird! Couldn't find it."
  577. }
  578.  
  579.  
  580. proc codewarriorCreateTagFile {} { return [alphaCreateTagFile] }
  581. proc thinkCreateTagFile {} { return [alphaCreateTagFile] }
  582. proc codewarriorCreateFileset {} { return [createWarriorFileset] }
  583. proc thinkCreateFileset {} { return [createThinkFileset] }
  584.  
  585. proc fromOpenWindowsCreateFileset {} {
  586.     global gfileSets
  587.     
  588.     set name [prompt "Create fileset containing current windows under what name?" "OpenWins"]
  589.  
  590.     addArrDef gfileSets $name [winNames -f]
  591.     set gfileSets($name) [winNames -f]
  592.  
  593.     return $name
  594. }
  595.  
  596. ##################################
  597. #                                 #
  598. #    Section    4: Menu    Procedures     #
  599. #                                 #
  600. ##################################
  601.  
  602. ## 
  603.  # Global procedures to    deal with the fact that    Alpha can only have    one
  604.  # menu    with each given    name.  This    is only    a problem in dealing with
  605.  # user-defined    menus such as fileset menus, tex-package menus,    ...
  606.  ##
  607.  
  608. ## 
  609.  # -------------------------------------------------------------------------
  610.  #     
  611.  #    "makeFilesetSubMenu" --
  612.  #    
  613.  #     If    desired    this is    the    only procedure you need    use    ---    it returns
  614.  #     a menu    creation string, taking    account    of the unique name requirement
  615.  #     and will make sure    your procedure 'proc' is called    with the real
  616.  #     menu name!
  617.  # -------------------------------------------------------------------------
  618.  ##
  619. proc makeFilesetSubMenu {fset name proc args} {
  620.     if { [string length $proc] > 1 } {
  621.         return [concat {menu -n} [list [registerFilesetMenuName $fset $name $proc]] -p subMenuProc $args]
  622.     } else {
  623.         return [concat {menu -n} [list [registerFilesetMenuName $fset $name]] $args]
  624.     }
  625. }
  626.  
  627. ## 
  628.  # -------------------------------------------------------------------------
  629.  #     
  630.  #    "registerFilesetMenuName" --
  631.  #    
  632.  #     Call to ensure    unique fileset submenu names.  We just add spaces
  633.  #     as    appropriate    and    keep track of everything for you!  Filesets
  634.  #     which have    multiple menus _must_ register the main    menu first.
  635.  # -------------------------------------------------------------------------
  636.  ##
  637. proc registerFilesetMenuName {fset name {proc ""}} {
  638.     global subMenuInfo subMenuFilesetInfo
  639.     if { $fset == $name && [info exists subMenuFilesetInfo($fset)] } {
  640.         # if the fileset already has a base menu, use that:
  641.         foreach n $subMenuFilesetInfo($fset) {
  642.             if { [string trimright $n] == $fset } {
  643.                 set base $n
  644.             } 
  645.             unset subMenuInfo($n)
  646.         }
  647.         unset subMenuFilesetInfo($fset)
  648.     }
  649.     set original $name                    
  650.     if [info exists base] {
  651.         set name $base
  652.     } else {
  653.         # I add at least one space to _all_ hierarchical submenus now.
  654.         # This is so I won't clash with any current or future modes
  655.         # which should never normally add spaces themselves.
  656.         append name " "
  657.         while { [info exists subMenuInfo($name)] } {
  658.             append name " "
  659.         }        
  660.     }
  661.     
  662.     set subMenuInfo($name) [list "$fset" "$original" "$proc"]
  663.     # build list of a fileset's menus
  664.     lappend subMenuFilesetInfo($fset) "$name"
  665.     
  666.     return $name
  667. }
  668.  
  669.  
  670. proc realMenuName {name} {
  671.     global subMenuInfo
  672.     return [lindex $subMenuInfo($name) 1]
  673. }
  674.  
  675. ## 
  676.  # -------------------------------------------------------------------------
  677.  #     
  678.  #    "subMenuProc" --
  679.  #    
  680.  #     This procedure    is implicitly used to deal with    ensuring unique
  681.  #     sub-menu names.  It calls the procedure you asked for,    with
  682.  #     the name of the menu you think    you're using.
  683.  # -------------------------------------------------------------------------
  684.  ##
  685. proc subMenuProc {menu item} {
  686.     global subMenuInfo
  687.     set l $subMenuInfo($menu)
  688.     set realProc [lindex $l 2]
  689.     # try and call the proc with three arguments (fileset is 1st)
  690.     if [catch {$realProc [lindex $l 0] [lindex $l 1] "$item"}] {
  691.         $realProc [lindex $l 1] "$item"
  692.     }
  693. }
  694.  
  695.  
  696. proc filesetMenuProc {menu item} {
  697.     global HOME
  698.     switch $item {
  699.         "Edit File" {
  700.         editFile
  701.         return
  702.         } 
  703.     "Help" {
  704.         editMark "$HOME:Help:Manual" "File Sets" -r
  705.         return
  706.         }
  707.     "New Fileset" {
  708.         return [newFileset]
  709.         }
  710.     "Delete Fileset" {
  711.         return [deleteFileset]
  712.         }
  713.     }
  714.  
  715. }
  716.  
  717. ## 
  718.  # -------------------------------------------------------------------------
  719.  #     
  720.  #    "filesetProc" --
  721.  #    
  722.  #     Must be called    by 'subMenuProc'
  723.  # -------------------------------------------------------------------------
  724.  ##
  725. proc filesetProc {fset menu item} {
  726.     global gfileSetsType 
  727.     if {$fset != ""} {set m $fset} else { set m $menu}
  728.     switch $gfileSetsType($m) {
  729.         "fromDirectory" -
  730.         "think" -
  731.         "codewarrior" -
  732.         "fromOpenWindows" {
  733.             filesetBasicOpen $m $item
  734.         }
  735.         "ftp" { ftpFilesetOpen $m $item }
  736.         "default" {
  737.             # try a type-specific method first
  738.             if [catch {eval $gfileSetsType($m)FilesetSelected \{$fset\} \{$menu\} \{$item\}}] {
  739.                 # if that failed then perhaps it only wants two parameters
  740.                 if [catch {eval $gfileSetsType($m)FilesetSelected \{$menu\} \{$item\}}] {
  741.                     # if that failed then just hope it's an ordinary list
  742.                     filesetBasicOpen $m $item
  743.                 }
  744.             }
  745.         }
  746.     }
  747.     
  748. }
  749.  
  750. proc filesetBasicOpen { menu item } {
  751.     if {[set match [lsearch [getFilesInSet $menu] *:$item]] >= 0} {
  752.         autoUpdateFileset $menu
  753.         generalOpenFile [lindex [getFilesInSet $menu] $match]
  754.     }
  755. }
  756.  
  757. proc generalOpenFile {file} {
  758.     getFileInfo $file a
  759.     if {$a(type) == "TEXT"} {
  760.         edit $file
  761.     } else {
  762.         sendOpenEvent -noreply Finder "${file}"
  763.     }
  764. }
  765.  
  766. proc registerUpdateProcedure { type proc } {
  767.     global filesetUpdateProcs
  768.     lappend filesetUpdateProcs($type) [list $proc]
  769. }
  770.  
  771. proc filesetUtilsProc { menu item } {
  772.     global filesetUtils gfileSetsType currFileSet filesetFlags filesetFlagsRebuild
  773.     if [info exists filesetUtils($item)] {
  774.         # it's a utility
  775.         set utilDesc $filesetUtils($item)
  776.         set allowedTypes [lindex $utilDesc 0]
  777.         if [string match $allowedTypes $gfileSetsType($currFileSet)] {
  778.             return [eval [lindex $utilDesc 1]]
  779.         } else {
  780.             beep
  781.             message "That utility can't be applied to the current file-set."
  782.             return
  783.         }
  784.     } elseif [info exists filesetFlags($item)] {
  785.         # it's a flag
  786.         
  787.         if [set    filesetFlags($item)    [expr 1    - $filesetFlags($item)]] {
  788.             markMenuItem "filesetFlags" $item on
  789.         } else {
  790.             markMenuItem "filesetFlags" $item off
  791.         }     
  792.          addArrDef filesetFlags "$item" "$filesetFlags($item)"
  793.         if [info exists filesetFlagsRebuild($item)] {
  794.             rebuildSomeFilesetMenu $filesetFlagsRebuild($item)
  795.         }
  796.         
  797.         return
  798.     } else {
  799.         $item
  800.     }
  801. }
  802.  
  803. proc getFilesInSet {fset} {
  804.     global gfileSets fileSetsTypesMenu gfileSetsType
  805.     switch $fileSetsTypesMenu($gfileSetsType($fset)) {
  806.         "list" {
  807.             return $gfileSets($fset)
  808.         }
  809.         "glob" {
  810.             global filesetFlags
  811.             if $filesetFlags(includeNonTextFiles) {
  812.                 return [glob -nocomplain "$gfileSets($fset)"]
  813.             } else {
  814.                 return [glob -nocomplain -t TEXT "$gfileSets($fset)"]
  815.             }
  816.         }
  817.         "default" {
  818.             global fileSets
  819.             return $fileSets($fset)
  820.         }
  821.     }
  822. }
  823.  
  824. proc makeFileSetAndMenu { name andMenu } {
  825.     global gfileSetsType fileSetsTypesMenu
  826.     message "Building ${name}..."
  827.     set type $gfileSetsType($name)
  828.     switch $fileSetsTypesMenu($type) {
  829.         "list" -
  830.         "glob" {
  831.             if $andMenu {
  832.                 set menu {}
  833.                 foreach m [getFilesInSet $name] {
  834.                     lappend menu "[file tail $m]\&"
  835.                 }
  836.                 return [makeFilesetSubMenu $name $name filesetProc -s -m [lsort -i $menu]]
  837.             } else {
  838.                 return
  839.             }
  840.         }
  841.         "default" {
  842.             return [${type}MakeFileSetAndMenu $name $andMenu]
  843.         }
  844.     }     
  845. }
  846.  
  847. proc filesetsSorted { order usedvar } {
  848.     upvar $usedvar used
  849.     global filesetFlags gfileSets gfileSetsType
  850.     set sets {}
  851.     foreach item $order {
  852.         switch -- [lindex $item 0] {
  853.           "-" { 
  854.               # add divider
  855.             lappend sets "(-" 
  856.             continue
  857.           } 
  858.           "*" {
  859.             # add all the rest
  860.               set subset {}
  861.             foreach s [array names gfileSets] {
  862.                 if ![listContains $used $s]  {
  863.                     lappend subset $s
  864.                     lappend used $s
  865.                 }
  866.             }
  867.             foreach f [lsort $subset] {
  868.                 lappend sets [makeFileSetAndMenu $f 1]
  869.             }
  870.           } 
  871.           "pattern" {
  872.               # find all which match a given pattern
  873.               set patt [lindex $item 1]
  874.               set subset {}
  875.             foreach s [array names gfileSets] {
  876.                 if ![listContains $used $s]  {
  877.                     if [string match $patt $s] {
  878.                         lappend subset $s
  879.                         lappend used $s
  880.                     }
  881.                 }
  882.             }
  883.             foreach f [lsort $subset] {
  884.                 lappend sets [makeFileSetAndMenu $f 1]
  885.             }
  886.               
  887.           }
  888.           "submenu" {
  889.               # add a submenu with name following and sub-order
  890.               set name [lindex $item 1]
  891.               set suborder [list [lindex $item 2]]
  892.               # we make kind of a pretend fileset here.
  893.               set subsets [filesetsSorted $suborder used]
  894.               if { $subsets != "" } {
  895.                   lappend sets [makeFilesetSubMenu $name $name filesetProc -m $subsets]
  896.               }
  897.           }
  898.           "default" {        
  899.             set subset {} 
  900.             foreach s [array names gfileSets] {
  901.                 if {[listContains $item $gfileSetsType($s)] && ![listContains $used $s]}  {
  902.                     lappend subset $s
  903.                     lappend used $s
  904.                 }
  905.             }
  906.             foreach f [lsort $subset] {
  907.                 lappend sets [makeFileSetAndMenu $f 1]
  908.             }
  909.           }
  910.         }
  911.     
  912.     }
  913.     # remove multiple and leading, trailing '-' in case there were gaps
  914.     regsub -all {\(-( \(-)+} $sets {(-} sets
  915.     while { [lindex $sets 0] == "(-" } { set sets [lrange $sets 1 end] }
  916.     set l [expr [llength $sets] -1]
  917.     if { [lindex $sets $l] == "(-" } { set sets [lrange $sets 0 [incr l -1]] }
  918.     
  919.     return $sets
  920. }
  921.  
  922.  
  923. # This should be used by "AlphaBits.tcl" for the initial build.
  924. # After that it is only necessary to call 'rebuildAllFilesets'.
  925. # Currently this proc is only necessary for backwards compatibility
  926. # It should be removed at some future date.
  927. proc rebuildFilesetMenu {} { 
  928.     global gfileSets gfileSetsType
  929.     foreach fset [array names gfileSets] {
  930.         if ![info exists gfileSetsType($fset)] { 
  931.             addArrDef gfileSetsType "$fset" "fromDirectory"
  932.             set gfileSetsType($fset) "fromDirectory" 
  933.         }        
  934.     }
  935.     
  936.     rebuildAllFilesets 
  937. }
  938.  
  939. ## 
  940.  # -------------------------------------------------------------------------
  941.  #     
  942.  #    "zapAndBuildFilesets" --
  943.  #    
  944.  #     This does a complete rebuild of all information.  The problem is that
  945.  #     the names of menus    may    actually change    (spaces    added/deleted).    This
  946.  #     is    not    a problem for the fileset menu,    but    is a problem for any
  947.  #     filesets which    have been added    to other menus,    since they won't know
  948.  #     that they need    to be rebuilt.
  949.  # -------------------------------------------------------------------------
  950.  ##
  951. proc zapAndBuildFilesets {} {
  952.     global subMenuInfo subMenuFilesetInfo
  953.     unset subMenuInfo
  954.     unset subMenuFilesetInfo
  955.     rebuildAllFilesets
  956. }
  957.  
  958. proc rebuildAllFilesets {} {
  959.     global gfileSets fsetMenuName  filesetSortOrder 
  960.     global filesetFlags filesetsNotInMenu
  961.     
  962.     if $filesetFlags(sortFilesetsByType) {
  963.         # just make file-sets for those we don't want in the menu
  964.         foreach f $filesetsNotInMenu {
  965.             makeFileSetAndMenu $f 0
  966.         }
  967.         
  968.         set used $filesetsNotInMenu
  969.         set sets [filesetsSorted $filesetSortOrder used]
  970.     } else {
  971.         foreach f [lsort [array names gfileSets]] {
  972.             set doMenu [expr ![listContains $filesetsNotInMenu $f]]
  973.             set menu [makeFileSetAndMenu $f $doMenu]
  974.             if { $doMenu && $menu != "" } {
  975.                 lappend sets $menu
  976.             }        
  977.         }            
  978.     }
  979.     
  980.     regsub -all {[-][nm]} $sets "" names
  981.     set names [map cadr $names]
  982.     set names [map "string trimright" $names]
  983.  
  984.     menu -m -n $fsetMenuName -p filesetMenuProc \
  985.         [concat {{/'Edit File…} {menu -n Utilities {}}} \
  986.         \{[list menu -n Palette -m -p filesetPalette $names]\} "Help" \
  987.         "(-" $sets]    
  988.     rebuildFilesetUtilsMenu
  989.     callFilesetUpdateProcedures
  990.     
  991.     message ""
  992. }
  993.  
  994. proc filesetPalette {menu item} {
  995.     float -m "$item " -n $item
  996. }
  997.  
  998.  
  999.  
  1000. ## 
  1001.  # -------------------------------------------------------------------------
  1002.  #     
  1003.  #    "rebuildSomeFilesetMenu" --
  1004.  #    
  1005.  #     If    given '*' rebuild the entire menu, else    rebuild    only those types
  1006.  #     given.     This is generally useful to avoid excessive rebuilding    when
  1007.  #     flags are adjusted
  1008.  # -------------------------------------------------------------------------
  1009.  ##
  1010. proc rebuildSomeFilesetMenu {amount} {
  1011.     global gfileSets gfileSetsType
  1012.     switch -- $amount {
  1013.         "*" {
  1014.             rebuildAllFilesets
  1015.         }
  1016.         "default" {
  1017.             foreach f [lsort [array names gfileSets]] {
  1018.                 if {$f == "Help"} continue
  1019.                 if [listContains $amount $gfileSetsType($f)] {
  1020.                     eval [makeFileSetAndMenu $f 1]
  1021.                 }
  1022.             
  1023.             }            
  1024.         }
  1025.     }
  1026.         
  1027. }
  1028.  
  1029. proc rebuildFilesetUtilsMenu {} {
  1030.     global gfileSets  currFileSet fileSetsTypesMenu filesetUtils filesetFlags
  1031.  
  1032.     menu -n "Utilities" -p filesetUtilsProc [concat \
  1033.         "newFileset…" \
  1034.         "deleteFileset…" \
  1035.         "updateCurrentFileset" \
  1036.         "<S<EzapAndBuildFilesets" \
  1037.         "<SrebuildAllFilesets" \
  1038.         \{[list menu -n choose -m -p changeFileSet [lsort [array names gfileSets]]]\} \
  1039.         \{[list menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]]\} \
  1040.         \{[list menu -n filesetFlags -p filesetUtilsProc [lsort [array names filesetFlags]]]\} \
  1041.         "(-" \
  1042.         "/T<I<OfindTag" \
  1043.         "createTagFile" \
  1044.         "(-" \
  1045.         [lsort [array names filesetUtils]] \
  1046.         ]
  1047.    
  1048.     filesetUtilsMarksTicks
  1049. }
  1050.  
  1051. proc rebuildSimpleFilesetMenus {} {
  1052.     global gfileSets fileSetsTypesMenu
  1053.     menu -n choose -m -p changeFileSet [lsort [array names gfileSets]]
  1054.     menu -n createFileset -p createFileset [array names fileSetsTypesMenu]
  1055.     menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]
  1056.     filesetUtilsMarksTicks
  1057. }
  1058.  
  1059. proc hideShowFileset { menu item } {
  1060.     global filesetsNotInMenu fsetMenuName
  1061.     if [listContains $filesetsNotInMenu $item] {
  1062.         set idx [lsearch $filesetsNotInMenu $item]
  1063.         set filesetsNotInMenu [lreplace $filesetsNotInMenu $idx $idx]        
  1064.         markMenuItem -m hideFileset $item off
  1065.         # would be better if we could just insert it
  1066.         rebuildAllFilesets
  1067.     } else {
  1068.         lappend filesetsNotInMenu $item
  1069.         markMenuItem -m hideFileset $item on 
  1070.         removeMenu $item
  1071.         if [catch { deleteMenuItem -m $fsetMenuName $item }] {
  1072.             # it's on a submenu and I can't be bothered to write
  1073.             # code to find that submenu name right now.
  1074.             rebuildAllFilesets
  1075.         }
  1076.     }
  1077. }
  1078.  
  1079. proc filesetUtilsMarksTicks {} {
  1080.     global currFileSet filesetFlags filesetsNotInMenu
  1081.     markMenuItem -m choose $currFileSet on
  1082.     
  1083.     foreach flag [array names filesetFlags] {
  1084.         if $filesetFlags($flag) {
  1085.             markMenuItem "filesetFlags" $flag on
  1086.         } else {
  1087.             markMenuItem "filesetFlags" $flag off
  1088.         }     
  1089.     }
  1090.     
  1091.     foreach name $filesetsNotInMenu {
  1092.         markMenuItem -m hideFileset $name on
  1093.     }
  1094.     
  1095. }
  1096.  
  1097.  
  1098. # Called in response to user changing filesets from the fileset menu.
  1099. proc changeFileSet {menu item} {
  1100.     global currFileSet tagFile
  1101.     
  1102.     markMenuItem -m choose $currFileSet off
  1103.     set currFileSet $item
  1104.     markMenuItem -m choose $currFileSet on
  1105.  
  1106.     # Bring in the tags file for this fileset
  1107.     set fname [tagFileName]
  1108.     if {[file exists $fname]} {
  1109.         if {[askyesno "Use tag file from folder \"$dir\" ?"] == "yes"} {
  1110.             set tagFile $fname
  1111.         }
  1112.     }
  1113. }
  1114.  
  1115. proc autoUpdateFileset { name } {
  1116.     global currFileSet filesetFlags
  1117.     if $filesetFlags(autoAdjustFileset) {
  1118.         set currFileSet $name
  1119.     }
  1120. }
  1121.  
  1122. #############################################
  1123. #                                            #
  1124. #    Section    5: General Utility procedures    #
  1125. #                                            #
  1126. #############################################
  1127.  
  1128. proc isWindowInFileset { {win "" } {type ""} } {
  1129.     if {$win == ""} { set win [lindex [winNames -f] 0] }
  1130.     global currFileSet gfileSets gfileSetsType
  1131.  
  1132.     if { $type == "" } {
  1133.         set okSets [array names gfileSets]
  1134.     } else {
  1135.         set okSets {}
  1136.         foreach s [array names gfileSets] {
  1137.             if { $gfileSetsType($s) == $type } {
  1138.                 lappend okSets $s
  1139.             }
  1140.         }
  1141.     }
  1142.     
  1143.     if [array exists gfileSets] {
  1144.         if {[lsearch -exact $okSets $currFileSet] != -1 } {
  1145.             # check current fileset
  1146.             if {[lsearch -exact [getFilesInSet $currFileSet] $win] != -1 } {
  1147.                 # we're set, it's in this fileset
  1148.                 return  $currFileSet
  1149.             }
  1150.         }
  1151.         
  1152.         # check other fileset
  1153.         foreach fset $okSets {
  1154.             if {[lsearch -exact [getFilesInSet $fset] $win] != -1 } {
  1155.                 # we're set, it's in this project
  1156.                 return  $fset
  1157.             }
  1158.         }   
  1159.     }
  1160.     return ""
  1161.     
  1162. }
  1163.  
  1164.  
  1165.  
  1166. ## 
  1167.  # -------------------------------------------------------------------------
  1168.  #     
  1169.  #    "iterateFileset" --
  1170.  # 
  1171.  #       Utility procedure to    iterate    over all files in a    project,
  1172.  #       calling some    predefined function    '$fn' for each member of
  1173.  #       project '$proj'.    The    results    of such    a call are passed to
  1174.  #       '$resfn'    if given. Finally "done" is    passed to 'resfn'.
  1175.  #     
  1176.  # -------------------------------------------------------------------------
  1177.  ##
  1178. proc iterateFileset { proj fn { resfn \# } } {
  1179.     global gfileSets gfileSetsType
  1180.     eval $resfn "first"
  1181.  
  1182.     set check [expr ![catch {$gfileSetsType($proj)IterateCheck check}]]
  1183.     
  1184.     foreach ff [getFileSet $proj] {
  1185.         if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
  1186.             continue
  1187.         }
  1188.         set res [eval $fn \{$ff\}]
  1189.         eval $resfn \{$res\}
  1190.         
  1191.     }
  1192.     
  1193.     if $check {
  1194.         catch {$gfileSetsType($proj)IterateCheck done}
  1195.     }
  1196.     
  1197.     eval $resfn "done"
  1198.  
  1199. }
  1200.  
  1201. ########################
  1202. #                       #
  1203. #    Section    6:    Tags   #
  1204. #                       #
  1205. ########################
  1206.  
  1207. if ![string length [info commands alphaFindTag]] {
  1208.     rename findTag alphaFindTag
  1209.     rename createTagFile alphaCreateTagFile
  1210. }
  1211.  
  1212. proc tagFileName {} {
  1213.     global gfileSets currFileSet 
  1214.     return [file dirname [car $gfileSets($currFileSet)]]:[join ${currFileSet}]TAGS
  1215. }
  1216.  
  1217. proc findTag {} {
  1218.     global gfileSetsType currFileSet
  1219.     # try a type-specific method first
  1220.     if [catch {$gfileSetsType($currFileSet)FindTag}] {
  1221.         alphaFindTag
  1222.     }
  1223. }
  1224.  
  1225. proc createTagFile {} {
  1226.     global gfileSetsType currFileSet tagFile modifiedVars
  1227.     set tagFile [tagFileName]
  1228.     lappend modifiedVars tagFile
  1229.  
  1230.     # try a type-specific method first
  1231.     if [catch {$gfileSetsType($currFileSet)CreateTagFile}] {
  1232.         alphaCreateTagFile
  1233.     }
  1234. }
  1235.  
  1236.  
  1237. ############################
  1238. #                           #
  1239. #        Section    7: Utils   #
  1240. #                           #
  1241. ############################
  1242.     
  1243.     
  1244. proc dirtyFileset { fset } {
  1245.     foreach f [getFilesInSet $fset] {
  1246.         if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
  1247.     }
  1248.     return 0
  1249. }
  1250.  
  1251. proc saveEntireFileset { fset } {
  1252.     foreach f [getFilesInSet $fset] {
  1253.         if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { 
  1254.             bringToFront $f
  1255.             save 
  1256.         }
  1257.     }
  1258. }
  1259.  
  1260. proc closeEntireFileset { {fset ""} } {
  1261.     set fset [pickFileset $fset "Close which fileset?" "popup"]
  1262.         
  1263.     foreach f [getFilesInSet $fset] {
  1264.         if ![catch {getWinInfo -w $f arr}] {
  1265.             bringToFront $f
  1266.             killWindow
  1267.         }
  1268.     }
  1269. }
  1270.  
  1271. proc fileToAlpha {f} {
  1272.     if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
  1273.         message "Converting $f"
  1274.         setFileInfo $f creator ALFA
  1275.     }    
  1276. }
  1277.  
  1278. proc filesetToAlpha {} {
  1279.     set fset [pickFileset "" {Convert all files from which fileset?} "popup"]
  1280.     iterateFileset $fset fileToAlpha
  1281. }
  1282.  
  1283. proc replaceInFileset {} {
  1284.     global gfileSets
  1285.  
  1286.     set from [prompt "Search string:" [searchString]]
  1287.     searchString $from
  1288.     set from [quoteExpr $from]
  1289.     regsub -all {&} $from {\\&} from
  1290.     set to [prompt "Replace string:" [replaceString]]
  1291.     replaceString $to
  1292.     set to [quoteExpr $to]
  1293.     regsub -all {&} $to {\\&} to
  1294.     set fsets [pickFileset "" "Which filesets?" "multilist"]
  1295.  
  1296.     if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
  1297.     saveAll
  1298.  
  1299.     set cid [scancontext create]
  1300.     scanmatch $cid $from {
  1301.         set matches($f) 1
  1302.     }
  1303.     foreach fset $fsets {
  1304.         foreach f [getFileSet $fset] {
  1305.             if {![catch {set fid [open $f]}]} {
  1306.                 message "Looking at '[file tail $f]'"
  1307.                 scanfile $cid $fid
  1308.                 close $fid
  1309.             }
  1310.         }
  1311.     }
  1312.     
  1313.     scancontext delete $cid
  1314.     
  1315.     foreach f [array names matches] {
  1316.         message "Modifying ${f}…"
  1317.         set cid [open $f "r"]
  1318.         if {[regsub -all $from [read $cid] $to out]} {
  1319.             set ocid [open $f "w+"]
  1320.             puts -nonewline $ocid $out
  1321.             close $ocid
  1322.         }
  1323.         close $cid
  1324.     }
  1325.     
  1326.     if {[buttonAlert "Revert affected windows?" "Yes" "No"] == "Yes"} {
  1327.         foreach f [array names matches] {
  1328.             bringToFront $f
  1329.             revert
  1330.         }
  1331.     }
  1332.     message ""
  1333. }
  1334.  
  1335. proc openEntireFileset {} {
  1336.     set fset [pickFileset "" "Open which fileset?" "popup"]
  1337.     
  1338.     # we use our iterator in case there's something special to do
  1339.     iterateFileset $fset "edit -c -w"
  1340. }
  1341.  
  1342. proc openFilesetFolder {} {
  1343.     global gfileSets
  1344.     set fset [pickFileset "" "Open which fileset's folder?" "popup"]
  1345.     titlebar [file dirname $gfileSets($fset)]
  1346. }
  1347.  
  1348. proc stuffFileset {} {
  1349.     global gfileSetsType gfileSets
  1350.     set fset [pickFileset "" "Which fileset shall I stuff?" "popup"]
  1351.     if [string length $fset] {
  1352.         if { $gfileSetsType($fset) == "fromDirectory" && \
  1353.              [askyesno "Stuff entire directory?"] == "yes" } {
  1354.              launchForeAppl DStf
  1355.              sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]:"
  1356.         } else {            
  1357.             launchForeAppl DStf
  1358.             eval sendOpenEvents 'DStf' [getFilesInSet $fset]
  1359.         }        
  1360.         sendQuitEvent 'DStf'
  1361.     }
  1362. }
  1363.  
  1364. proc filesetRememberOpenClose { file } {
  1365.     global fileset_openorclosed
  1366.     set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
  1367. }
  1368.  
  1369. proc filesetRevertOpenClose { file } {
  1370.     global fileset_openorclosed
  1371.     if { [lindex $fileset_openorclosed 0] == "$file" } {
  1372.         if { [lindex $fileset_openorclosed 1] < 0 } {
  1373.             killWindow
  1374.         }
  1375.     }    
  1376.     catch {unset fileset_openorclosed}
  1377. }
  1378.  
  1379. proc wordCountFileset {} {
  1380.   global currFileSet
  1381.   iterateFileset $currFileSet wordCountProc filesetUtilWordCount
  1382. }
  1383.  
  1384. proc wordCountFilesetFast {} {
  1385.   global currFileSet
  1386.   iterateFileset $currFileSet wc filesetUtilWordCount
  1387. }
  1388.  
  1389. proc filesetUtilWordCount { count } {
  1390.     global fs_ccount fs_wcount fs_lcount
  1391.     switch $count {
  1392.         "first" {
  1393.             set fs_ccount 0
  1394.             set fs_wcount 0
  1395.             set fs_lcount 0
  1396.         }       
  1397.         "done" {
  1398.             alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_ccount chars"
  1399.             unset fs_ccount fs_wcount fs_lcount
  1400.         }
  1401.         default {
  1402.             incr fs_ccount [lindex $count 2]
  1403.             incr fs_wcount [lindex $count 1]
  1404.             incr fs_lcount [lindex $count 0]
  1405.         }
  1406.     }
  1407. }
  1408.  
  1409.  
  1410.  
  1411. ##
  1412.  # ----------------------------------------------------------------------
  1413.  #
  1414.  #  "wordCountProc" --
  1415.  #
  1416.  #   We use this proc to count words.  Calling 'wc' would be quicker (it is a 
  1417.  #   C procedure and doesn't require the opening of a file), however it seems 
  1418.  #   to have a HUGE memory leak so is a bit useless for our purposes.
  1419.  #
  1420.  # ----------------------------------------------------------------------
  1421.  ##
  1422. proc wordCountProc { file } {
  1423.     filesetRememberOpenClose "$file"
  1424.     openFileQuietly "$file"
  1425.     set chars [maxPos]
  1426.     set lines [lindex [posToRowCol $chars] 0]
  1427.     set text [getText 0 [maxPos]]
  1428.     regsub -all {[!=;.,\(\#\=\):\{\"\}]} $text " " ret
  1429.     set words [llength $ret]
  1430.     unset text ret
  1431.     filesetRevertOpenClose $file
  1432.     return "$chars $words $lines"
  1433. }
  1434.  
  1435.  
  1436.  
  1437.  
  1438. # Should be last so all filesets make it in.
  1439. message "Building filesets..."
  1440.  
  1441. rebuildFilesetMenu
  1442.  
  1443.  
  1444.  
  1445.